home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacGambit 2.0 / sources1 / Runtime (.c & .h) / load.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-06-04  |  18.3 KB  |  349 lines  |  [TEXT/KAHL]
  1. /* Loading of .O files */
  2.  
  3. #include "params.h"
  4. #include "gambit.h"
  5. #include "struct.h"
  6. #include "os.h"
  7. #include "mem.h"
  8. #include "strings.h"
  9. #include "opcodes.h"
  10. #include "run.h"
  11. #include "stats.h"
  12. #include "emul.h"
  13.  
  14.  
  15. /*---------------------------------------------------------------------------*/
  16.  
  17.  
  18. struct patch_rec {
  19.   struct patch_rec *next; /* next entry in the patch list    */
  20.   long index;             /* index to value's source         */
  21.   SCM_obj *loc;           /* pointer to location to patch to */
  22.   };
  23.  
  24. typedef struct patch_rec *PATCH_PTR;
  25.  
  26.  
  27. char *alloc_ptr, *read_bot, *read_top, *load_bot, *load_top, *load_ptr;
  28. SCM_obj *object;
  29. PATCH_PTR free_patches, prim_patches;
  30. char *filename, *procedure_name;
  31.  
  32.  
  33. char *alloc( len )
  34. long len;
  35. { long len2 = ceiling8( len );
  36.   if (alloc_ptr-len2 < read_top)
  37.   { os_err = "Load memory overflow"; return NULL; }
  38.   alloc_ptr -= len2;
  39.   return alloc_ptr;
  40. }
  41.  
  42.  
  43. long begin_load()
  44. { free_patches = NULL;
  45.   prim_patches = NULL;
  46.   read_bot = pstate->heap_old;
  47.   alloc_ptr = read_bot + (pstate->heap_mid - pstate->heap_bot);
  48.   read_top = read_bot;
  49.   object = (SCM_obj *)alloc( sizeof(SCM_obj) * (long)MAX_NB_OBJECTS_PER_FILE );
  50.   return (object == NULL);
  51. }
  52.  
  53.  
  54. long end_load()
  55. { PATCH_PTR patch = prim_patches;
  56.   while (patch != NULL)
  57.   { SCM_obj val = sstate->globals[patch->index].value;
  58.     if (val == (long)SCM_unbound)
  59.     { os_err = string_append( "Undefined primitive, ",
  60.                               global_name(patch->index) );
  61.       return 1;
  62.     }
  63.     *(patch->loc) += val; /* patch up reference to the primitive */
  64.     patch = patch->next;
  65.   }
  66.   return 0;
  67. }
  68.  
  69.  
  70. long eof()
  71. { os_err = "Premature EOF";
  72.   return 1;
  73. }
  74.  
  75.  
  76. #define load_long_word(var) \
  77. { if (load_ptr+4>load_top) return eof(); var = *(long *)load_ptr; load_ptr += 4; }
  78.  
  79. #define load_word(var) \
  80. { if (load_ptr+2>load_top) return eof(); var = *(short *)load_ptr; load_ptr += 2; }
  81.  
  82. #define load_words( n, ptr ) \
  83. { register long i = (n); register short *pt = (ptr); \
  84.   if (load_ptr + i*2 > load_top) return eof(); \
  85.   while (i>0) { *(pt++) = *(short *)load_ptr; load_ptr += 2; i--; } \
  86. }
  87.  
  88.  
  89. long load_string( str )
  90. char **str;
  91. { *str = load_ptr;
  92.   while (*(load_ptr++) != '\0') if (load_ptr > load_top) return eof();
  93.   load_ptr = (char *)ceiling2( load_ptr );
  94.   if (load_ptr > load_top) return eof();
  95.   return 0;
  96. }
  97.  
  98.  
  99. long skip_string( offset )
  100. long *offset;
  101. { *offset = load_ptr - load_bot;
  102.   while (*(load_ptr++) != '\0') if (load_ptr > load_top) return eof();
  103.   load_ptr = (char *)ceiling2( load_ptr );
  104.   if (load_ptr > load_top) return eof();
  105.   return 0;
  106. }
  107.  
  108.  
  109. /*---------------------------------------------------------------------------*/
  110.  
  111.  
  112. long nb_objects, highest_object, nb_symbols;
  113. PATCH_PTR object_patches, M68020_patches, M68881_patches;
  114.  
  115.  
  116. long add_object( value )
  117. SCM_obj value;
  118. { long i = nb_objects++;
  119.   if (i + nb_symbols >= (long)MAX_NB_OBJECTS_PER_FILE)
  120.   { os_err = "Too many objects in an object file"; return 1; }
  121.   object[i] = value;
  122.   return 0;
  123. }
  124.  
  125.  
  126. long add_patch( list, index, loc )
  127. PATCH_PTR *list;
  128. long index;
  129. SCM_obj *loc;
  130. { PATCH_PTR patch;
  131.   if (free_patches != NULL)
  132.   { patch = free_patches;
  133.     free_patches = free_patches->next;
  134.   }
  135.   else
  136.   { patch = (PATCH_PTR)alloc( (long)sizeof(struct patch_rec) );
  137.     if (patch == NULL) return 1;
  138.   }
  139.   patch->next  = *list;
  140.   patch->index = index;
  141.   patch->loc   = loc;
  142.   *list        = patch;
  143.   return 0;
  144. }
  145.  
  146.  
  147. long add_prim_patch( index, loc )
  148. long index;
  149. SCM_obj *loc;
  150. { return add_patch( &prim_patches, index, loc );
  151. }
  152.  
  153.  
  154. long add_object_patch( index, loc )
  155. long index;
  156. SCM_obj *loc;
  157. { if (index + nb_symbols >= (long)MAX_NB_OBJECTS_PER_FILE)
  158.   { os_err = "Object reference too big"; return 1; }
  159.   if (index > highest_object) highest_object = index;
  160.   return add_patch( &object_patches, index, loc );
  161. }
  162.  
  163.  
  164. long patchup_M68020_emul_code()
  165. { PATCH_PTR patch = M68020_patches;
  166.   while (patch != NULL)
  167.   { PATCH_PTR next = patch->next;
  168.     if (emul_M68020_instr( (short *)patch->loc )) return 1;
  169.     patch->next = free_patches;
  170.     free_patches = patch;
  171.     patch = next;
  172.   }
  173.   return 0;
  174. }
  175.  
  176.  
  177. long patchup_M68881_emul_code()
  178. { PATCH_PTR patch = M68881_patches;
  179.   while (patch != NULL)
  180.   { PATCH_PTR next = patch->next;
  181.     if (emul_M68881_instr( (short *)patch->loc )) return 1;
  182.     patch->next = free_patches;
  183.     free_patches = patch;
  184.     patch = next;
  185.   }
  186.   return 0;
  187. }
  188.  
  189.  
  190. long load_sym( i, loc )
  191. short i;
  192. SCM_obj *loc;
  193. { if (i == INDEX_MASK)
  194.   { char *name;
  195.     long j = nb_symbols++;
  196.     if (j + nb_objects >= (long)MAX_NB_OBJECTS_PER_FILE)
  197.     { os_err = "Too many symbols in an object file"; return 1; }
  198.     if (load_string( &name )) return 1;
  199.     if (alloc_symbol( name, loc )) return 1;
  200.     object[MAX_NB_OBJECTS_PER_FILE-1-j] = *loc;
  201.    }
  202.   else if (i > nb_symbols)
  203.   { os_err = "Symbol reference out of range"; return 1; }
  204.   else
  205.     *loc = object[MAX_NB_OBJECTS_PER_FILE-1-i];
  206.   return 0;
  207. }
  208.  
  209.  
  210. long load_value( loc )
  211. SCM_obj *loc;
  212. { long val, masked;
  213.   load_long_word( val );
  214.   masked = val & ~(((long)INDEX_MASK) << 3);
  215.   if (masked == (long)OBJECT)
  216.   { *loc = (SCM_obj)0;
  217.     if (add_object_patch( (val >> 3) & INDEX_MASK, loc )) return 1;
  218.   }
  219.   else if (masked == (long)SYMBOL)
  220.   { if (load_sym( (short)((val >> 3) & INDEX_MASK), loc )) return 1;
  221.   }
  222.   else if (masked == (long)PRIM_PROC)
  223.   { SCM_obj sym;
  224.     long index;
  225.     if (load_sym( (short)((val >> 3) & INDEX_MASK), &sym )) return 1;
  226.     if (alloc_global_from_symbol( sym, &index )) return 1;
  227.     if (add_prim_patch( index, loc )) return 1;
  228.     *loc = (SCM_obj)0;
  229.   }
  230.   else
  231.     *loc = (SCM_obj)val;
  232.   return 0;
  233. }
  234.  
  235.  
  236. long load_proc( proc_adr, len, name )
  237. SCM_obj proc_adr;
  238. long len;
  239. char *name;
  240. { short *code_ptr = (short *)proc_adr;
  241.  
  242.   procedure_name = name;
  243.  
  244.   M68020_patches = NULL;
  245.   M68881_patches = NULL;
  246.  
  247.   while (1)
  248.   { short tag;
  249.  
  250.     load_word( tag );
  251.  
  252.     if (tag > 0)
  253.     { load_words( tag, code_ptr );
  254.       code_ptr += tag;
  255.     }
  256.  
  257.     else if (tag == (short)PADDING_TAG)
  258.       /* just skip */;
  259.  
  260.     else if (tag == (short)END_OF_CODE_TAG)
  261.       break;
  262.  
  263.     else if (tag == (short)M68020_TAG)
  264.     { if (!os_M68020)
  265.         if (add_patch( &M68020_patches, 0L, (SCM_obj *)code_ptr )) return 1;
  266.     }
  267.  
  268.     else if (tag == (short)M68881_TAG)
  269.     { if (!os_M68881)
  270.         if (add_patch( &M68881_patches, 0L, (SCM_obj *)code_ptr )) return 1;
  271.     }
  272.  
  273.     else if (tag == (short)STAT_TAG)
  274.     { long index;
  275.       if (alloc_stat( &index ))
  276.       { os_err = "Statistics table overflow"; return 1; }
  277.       else
  278.       { *(long **)code_ptr = &pstate->stats_counters[index];
  279.         code_ptr += 2;
  280.         if (skip_string( &sstate->stats_offsets[index] )) return 1;
  281.       }
  282.     }
  283.  
  284.     else
  285.     { short i = tag & INDEX_MASK;
  286.       tag = tag & ~INDEX_MASK;
  287.  
  288.       if (tag == (short)PROC_REF_TAG)
  289.       { if (add_object_patch( (long)i, (SCM_obj *)code_ptr )) return 1;
  290.         load_word( *(long *)code_ptr );
  291.         code_ptr += 2;
  292.       }
  293.  
  294.       else if (tag == (short)GLOBAL_VAR_REF_TAG)
  295.       { SCM_obj sym;
  296.         long index;
  297.         if (load_sym( i, &sym )) return 1;
  298.         if (alloc_global_from_symbol( sym, &index )) return 1;
  299.         *(code_ptr++) = table_offset( &sstate->globals[index].value );
  300.       }
  301.  
  302.       else if (tag == (short)GLOBAL_VAR_SET_TAG)
  303.       { SCM_obj sym;
  304.         long index;
  305.         if (load_sym( i, &sym )) return 1;
  306.         if (alloc_global_from_symbol( sym, &index )) return 1;
  307.         *(code_ptr++) = table_offset( &sstate->globals[index].value );
  308.         *(code_ptr++) = LEAA6_DISP_A1_OP;
  309.         *(code_ptr++) = table_offset( &sstate->tramps[index] );
  310.         *(code_ptr++) = MOVE_L_A1_A6_DISP_OP;
  311.         *(code_ptr++) = table_offset( &sstate->globals[index].jump_adr );
  312.       }
  313.  
  314.       else if (tag == (short)GLOBAL_VAR_REF_JUMP_TAG)
  315.       { SCM_obj sym;
  316.         long index;
  317.         if (load_sym( i, &sym )) return 1;
  318.         if (alloc_global_from_symbol( sym, &index )) return 1;
  319.         *(code_ptr++) = table_offset( &sstate->globals[index].jump_adr );
  320.       }
  321.  
  322.       else if (tag == (short)PRIM_REF_TAG)
  323.       { SCM_obj sym;
  324.         long index;
  325.         if (load_sym( i, &sym )) return 1;
  326.         if (alloc_global_from_symbol( sym, &index )) return 1;
  327.         if (add_prim_patch( index, (SCM_obj *)code_ptr )) return 1;
  328.         load_word( *(long *)code_ptr );
  329.         code_ptr += 2;
  330.       }
  331.  
  332.       else
  333.       { os_err = "Procedure object format error"; return 1; }
  334.     }
  335.  
  336.   }
  337.  
  338.   { long i, rest = len - ( ((long)code_ptr) - ((long)proc_adr) - 2 );
  339.     if ((rest < 0L) || ((rest & 3L) != 0))
  340.     { os_err = "Procedure object format error"; return 1; }
  341.     for (i=rest/4; i>0; i--)
  342.     { if (load_value( (SCM_obj *)code_ptr )) return 1;
  343.       code_ptr += 2;
  344.     }
  345.   }
  346.  
  347.   /* do patchup for emulation code */
  348.  
  349.   if (patchup_M6